home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_geomview.idb / usr / freeware / lib / geomview / modules / tcl / Labeler.z / Labeler
Encoding:
Text File  |  1999-01-26  |  6.6 KB  |  235 lines
  1. #   Copyright (c) 1995 The Geometry Center; University of Minnesota
  2. #   1300 South Second Street;  Minneapolis, MN  55454, USA;
  3. #   
  4. # This file is part of geomview/OOGL. geomview/OOGL is free software;
  5. # you can redistribute it and/or modify it only under the terms given in
  6. # the file COPYING, which you should have received along with this file.
  7. # This and other related software may be obtained via anonymous ftp from
  8. # geom.umn.edu; email: software@geom.umn.edu.
  9.  
  10. # Author: Timothy Rowley
  11.  
  12. emodule_init labeler
  13.  
  14. # set up nicer-looking gray colors
  15.  
  16. #option add *Background gray70 userDefault
  17. #option add *Foreground gray20 userDefault
  18. #option add *Checkbutton.selector yellow userDefault
  19. #option add *Radiobutton.selector yellow userDefault
  20. #. configure -background gray70
  21.  
  22. set family VECTOR
  23. set weight Medium
  24. set slant Roman
  25. set size 14
  26. set string ""
  27.  
  28. proc doSelect {} {
  29.     global family weight slant size
  30.  
  31.     foreach i "family weight slant size" {
  32.     eval set item $$i
  33.     set index [lsearch -exact [.$i get 0 end] $item]
  34.     .$i selection set $index
  35.     .$i see $index
  36.     }
  37. }
  38.  
  39. proc doInsert {type name} {
  40.     set s [.$type get 0 end]
  41.     if {[lsearch -exact $s $name] == -1} {
  42.     set s [lsort [concat $s $name]]
  43.     .$type delete 0 end
  44.     eval .$type insert end $s
  45.     doSelect
  46.     }
  47. }
  48.     
  49. proc doDelete {type name} {
  50.     set s [.$type get 0 end]
  51.     set index [lsearch -exact $s $name]
  52.     if {$index != -1} {
  53.     set s [concat [lrange $s 0 [expr $index-1]] [lrange $s [expr $index+1] end]]
  54.     .$type delete 0 end
  55.     eval .$type insert end $s
  56.     doSelect
  57.     }
  58. }
  59.  
  60. proc vectorString {s} {
  61.   if {[catch {
  62.     exec hvectext -s .25 -align sw -plane xy -at 0 0 0 -- $s >@ stdout
  63.     } trouble] != 0} {
  64.     puts stderr "Labeler: Error invoking hvectext: $trouble"
  65.   }
  66. }
  67.  
  68.     
  69. proc doText {} {
  70.     global string family weight slant size
  71.  
  72.     if {$string == ""} {
  73.     return
  74.     }
  75.     puts "(geometry \"$string\" { "
  76.     if {$family != "VECTOR"} {
  77.     scanFont $family $weight $slant $size $string
  78.     } else {
  79.     vectorString $string
  80.     }
  81.     puts "})"
  82.     flush stdout
  83. }
  84.  
  85.  
  86. proc setValue {window} {
  87.     regsub "\." $window "" name
  88.     upvar #0 $name handle
  89.     if {[$window curselection] != ""} {
  90.     set handle [lindex [$window get 0 end] [$window curselection]]
  91.     }
  92. }
  93.  
  94. proc mkListbox {frame name width entries} {
  95.     frame .fancy.$frame
  96.     label .fancy.$frame.l -text $name
  97.     frame .fancy.$frame.f
  98.     listbox .[string tolower $name] -height 6 -width $width \
  99.     -exportselection false -setgrid 1 -selectmode single
  100.     if {[llength $entries] > 6} {
  101.     scrollbar .fancy.$frame.f.s -command ".[string tolower $name] yview"
  102.     .[string tolower $name] configure -yscroll ".fancy.$frame.f.s set"
  103.     pack .fancy.$frame.f.s -side right -fill y
  104.     }
  105.     eval .[string tolower $name] insert end $entries
  106.     pack .[string tolower $name] -in .fancy.$frame.f -side left \
  107.     -expand yes -fill both
  108.     pack .fancy.$frame.l .fancy.$frame.f -side top
  109.     bind .[string tolower $name] <ButtonRelease-1> \
  110.     {setValue %W; handleFont $family $weight $slant $size}
  111. }
  112.  
  113. proc changeFont {font} {
  114.     . configure -cursor watch
  115.     .f.e configure -font $font
  116.     update idletasks
  117.     . configure -cursor {}
  118.     update idletasks
  119. }
  120.  
  121. proc fixSize {window} {
  122.     update idletasks
  123.     set geometry [split [wm geometry $window] "+-x"]
  124.     eval wm maxsize $window [lrange $geometry 0 1]
  125.     eval wm minsize $window [lrange $geometry 0 1]
  126. }
  127.  
  128. proc mkMain {} {
  129.     wm title . Labeler
  130.     . configure -borderwidth 2 -relief raised
  131.     frame .top
  132.     label .top.l -font -*-helvetica-*-r-*-*-*-240-*-*-*-*-*-* -text "Labeler"
  133.     button .top.info -text Info -command mkInfo
  134.     button .top.exit -text Exit -command exit
  135.     pack .top.info -side left
  136.     pack .top.exit -side right
  137.     pack .top.l -side left -expand 1 -fill x
  138.  
  139.     frame .f
  140.     label .f.l -text Text: -height 2
  141.     entry .f.e -textvariable string -width 5
  142.     pack .f.l .f.e -side left
  143.     pack .f.e -side left -expand 1 -fill x
  144.  
  145.     pack .top .f -side top -expand 1 -fill x
  146.     frame .fancy
  147.  
  148.     mkListbox f1 Family 22 "[lsort [concat VECTOR [getFonts]]]"
  149.     mkListbox f2 Weight 9 [getWeights]
  150.     mkListbox f3 Slant 7 [getSlants]
  151.     mkListbox f4 Size 4 [getSizes]
  152.  
  153.     pack .fancy.f1 .fancy.f2 .fancy.f3 .fancy.f4 -side left -padx 2
  154.     pack .fancy
  155.  
  156.     fixSize .
  157.     bind .f.e <Return> doText
  158.     focus .f.e
  159. }
  160.  
  161. proc mkInfo {} {
  162.     if {[winfo exists .info]} {
  163.     wm deiconify .info
  164.     return
  165.     }
  166.     toplevel .info -relief raised -borderwidth 2
  167.     wm title .info Info
  168.     frame .info.f
  169.     label .info.f.l -font -*-helvetica-bold-r-*-*-*-240-*-*-*-*-*-* \
  170.     -text "Labeler Info"
  171.     button .info.f.b -text "Hide" -command "wm withdraw .info"
  172.     pack .info.f.l -side left -expand 1 -fill x
  173.     pack .info.f.b -side right
  174.     frame .info.t
  175.     text .info.t.t -width 42 -height 8 -yscrollcommand ".info.t.s set" \
  176.     -font -*-helvetica-medium-r-*-*-*-140-*-*-*-*-*-*
  177.     scrollbar .info.t.s -command ".info.t.t yview"
  178.     pack .info.t.s -side right -fill y
  179.     pack .info.t.t -side left -fill both
  180.     .info.t.t insert end \
  181. "By Timothy Rowley
  182. Version 1.5
  183. Copyright (c) 1995
  184. The Geometry Center
  185. WWW: http://www.geom.umn.edu/
  186. Anonymous ftp: ftp.geom.umn.edu
  187. email: software@geom.umn.edu
  188.  
  189. Labeler takes a text string and turns it into a
  190. three dimensional object which can be manipulated
  191. inside of Geomview.
  192.  
  193. Labeler can generate text object using many
  194. different fonts.  Select the font you want to use
  195. by selecting the font Family, Weight, Slant, and
  196. Size in the bottom area.  The \"VECTOR\" font is
  197. special - it is carefully constructed of a small
  198. number of polylines.  Geomview can handle more of
  199. this font without slowing down.  The \"Size\"
  200. changes the size of the unnormalized text string.
  201. A higher \"Size\" will also generate a higher
  202. quality object composed of more polygons.
  203.  
  204. Type the string you want into the text entry
  205. field.  The text will appear in the selected font.
  206. Pressing enter will create an geomview object with
  207. a name equal to the string.
  208.  
  209. Labeler gives you the choice of the standard X
  210. fonts (Charter, Courier, Helvetica, New Century
  211. Schoolbook, and Times) plus any scalable fonts the
  212. X server supports.  Unfortunately, X supports two
  213. types of scalable fonts: bitmaps and outline.
  214. Outline fonts scale smoothly to any size.  Scaled
  215. bitmap fonts are generally of poor quality.  Xlib
  216. does not provide any way to tell bitmap and
  217. outline fonts apart, so Labeler can't prevent you
  218. from choosing a poor quality font.
  219.  
  220. You may notice that Labeler causes your
  221. workstation to \"freeze\" momentarily when you
  222. interact with it.  This happens because the X
  223. server locks up when asked to load or scale a
  224. font.  "  
  225.     .info.t.t configure -state disabled
  226.     pack .info.f .info.t -side top -expand 1 -fill x 
  227.     fixSize .info
  228. }
  229.  
  230. mkMain
  231. doSelect
  232. handleFont $family $weight $slant $size
  233. flush stdout
  234.  
  235.